home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 4 / ETO Development Tools 4.iso / Tools - Objects / MacApp / MacApp 3.0a2 / Libraries / UPascalObject.cp < prev    next >
Encoding:
Text File  |  1991-05-01  |  28.9 KB  |  1,026 lines  |  [TEXT/MPS ]
  1. // UObject.cp 
  2. // Copyright © 1984-1990 by Apple Computer, Inc.  All rights reserved.
  3.  
  4. #ifndef __UFAILURE__
  5. #include <UFailure.h>
  6. #endif
  7.  
  8. #ifndef __STDIO__
  9. #include <StdIo.h>
  10. #endif
  11.  
  12. #ifndef __UOBJECT__
  13. #include <UObject.h>
  14. #endif
  15.  
  16. #ifndef __ULIST__
  17. #include <UList.h>
  18. #endif
  19.  
  20. #ifndef __UPATCH__
  21. #include <UPatch.h>
  22. #endif
  23.  
  24. #ifndef __UMEMORY__
  25. #include <UMemory.h>
  26. #endif
  27.  
  28. #ifndef __TEXTEDIT__
  29. #include <Textedit.h>
  30. #endif
  31.  
  32. #ifndef __OSUTILS__
  33. #include <OSUtils.h>
  34. #endif
  35.  
  36. #ifndef __UMACAPPUTILITIES__
  37. #include <UMacAppUtilities.h>
  38. #endif
  39.  
  40. #ifndef __UITERATOR__
  41. #include <UIterator.h>
  42. #endif
  43.  
  44. #ifndef __UDEBUG__
  45. #include <UDebug.h>
  46. #endif
  47. #ifndef __UINSPECTOR__
  48. #include <UInspector.h>
  49. #endif
  50.  
  51. #ifndef qMacApp
  52. #define qMacApp FALSE
  53. #endif
  54.  
  55. //=====
  56. // case NOTE:
  57. // The optimizer redirects the following procedure names
  58. // We call the optimized names here since non-optimized dispatch
  59. // is not supported.
  60.  
  61. // %_INITOBJ  becomes %_OPTINITOBJ
  62. // %_INOBJ  becomes   %_OPTINOBJ
  63. // %_SETCLASSINDEX   becomes %_OPTSETCI
  64. // %_METHOD becomes   %_JMPTOTRAP
  65.  
  66. //--------------------------------------------------------------------------------------------------
  67. // Typedef for void pascal procedures.
  68.  
  69. typedef pascal void (*PascalProc)();
  70.  
  71. //--------------------------------------------------------------------------------------------------
  72.  
  73. const short kJTSkipOver = 2;                            // size of jmp (or loadseg) instruction that
  74.                                                         // must be skipped in the JT Entry in order
  75.                                                         // to get to the target address
  76. const char* kInvalidObj = "*Not an object*";            // return value from LookupObjName if not an object
  77.  
  78. // SuperClassTable format
  79. typedef ObjClassID SuperClassTableSize;                    // in 32 B-E is a longint else int
  80.  
  81. struct SuperClassTable
  82. {
  83.     SuperClassTableSize itsSize;
  84.     ObjClassID            itsTable[1];                     // Actually, a variable size array where each
  85.                                                         // entry's byte offset corresponds to its
  86.                                                         // ClassID and the entry's value is the
  87.                                                         // ClassID of the immediate superclass
  88. };
  89.     
  90. typedef SuperClassTable* SuperClassTablePtr;
  91. typedef    SuperClassTablePtr* SuperClassTableHandle;
  92.  
  93. // ClassInfoProc format
  94. struct ClassInfoProc
  95. {
  96.     ObjClassID    itsClassID;
  97.     short        itsInstanceSize;
  98.     MAName        itsName;
  99. };
  100.  
  101. typedef ClassInfoProc* ClassInfoProcPtr;
  102. typedef    ClassInfoProcPtr* ClassInfoProcHandle;
  103.  
  104. // ClassTable format
  105. typedef    ObjClassID ClassTableSize;                        // in 32 B-E is a long else int
  106.  
  107. #if qModelFarCode
  108. typedef Ptr ClassTableEntry;                            // Ptr to the JT Entry of the ClassInfoProc.
  109.                                                         // Add kJTSkipOver and you get a ClassInfoProcPtr.
  110. #else
  111. typedef short ClassTableEntry;                            // JT Offset of ClassInfoProc 
  112. #endif
  113.  
  114. typedef ClassTableEntry* ClassTableEntryPtr;
  115. typedef ClassTableEntryPtr* ClassTableEntryHandle;
  116.  
  117. struct ClassTable
  118. {
  119.     ClassTableSize    itsSize;
  120.     ClassTableEntry    itsTable[1];                         // Actually, a variable size array where
  121.                                                         // each entry's byte offset corresponds
  122.                                                         // to its ClassID and the entry's value
  123.                                                         // is used to locate its ClassInfoProc.
  124. };
  125. typedef ClassTable* ClassTablePtr;
  126. typedef ClassTablePtr* ClassTableHandle;
  127.  
  128. typedef pascal void (* DoToClassType)(ObjClassID theClass, void* staticLink);
  129.  
  130. class TNameOrderedClassIDs: public TSortedLongintList
  131. {
  132. public:
  133.     pascal CompareResult TNameOrderedClassIDs::Compare(long item1, long item2); // override 
  134.     // Overridden to string compare the actual names of the classes 
  135.     
  136.     pascal ObjClassID TNameOrderedClassIDs::ClassIDWithName(MAName keyStr);
  137. };
  138.  
  139. //--------------------------------------------------------------------------------------------------
  140.  
  141.     ObjProcs                 gObjProcs;
  142.  
  143.     TNameOrderedClassIDs*    pOrderedClassIds;            // Classes ordered by name 
  144.     ObjClassID                pTObjectClassID;             // ClassID of the Root class
  145.  
  146.     Boolean                    pDisciplineMethodCalls;        // Discipline method calls 
  147.     Boolean                    pDisciplineCoercions;        // Discipline Coercions 
  148.     SuperClassTablePtr        pSuperClassTable;             // ptr to superclass table 
  149.     ClassTablePtr            pClassTable;                // ptr to superclass table 
  150.     pascal void                (*pDispatchErrorProc)();    // Routine to handle dispatching failures 
  151.     pascal void                (*pODFail)(TObject *);        // address OD Failure Handler 
  152.     Boolean                    pAllocateObjectsFromPerm;    // Used to track whether to allocate objects
  153.                                                         // from permanent memory or not.
  154.     TObject*                pCacheObj = NULL;
  155.     
  156. //--------------------------------------------------------------------------------------------------
  157. // The following variables are initialized by a procedure called InitLinkerSymbols in UPascalObject.a.
  158. // They are copies of the address of corresponding symbols created by the linker. The linker symbols
  159. // begin with a '%_' instead of a 'g'. C++ identifiers cannot contain a '%'.
  160.  
  161. Ptr gSuperClassTable;                        // Created by linker -Model Far and -opt 
  162. Ptr gClassTable;                            // Created by linker for -Model Far and -opt 
  163. Ptr gSelectorProcTable;                        // Created by linker for -Model Far and -opt 
  164. Ptr gClassInfo;                                // Created by linker… except for -Model Far and -opt
  165.  
  166. Ptr gJmpToTrapPatchPoint;                    // Location to patch in the MacApp dispatcher.
  167. Ptr gMethDispAddr;                            // Address of the MacApp dispatcher.
  168. Ptr gDisciplinedMethDispAddr;                // Address of the disciplined MacApp dispatcher.
  169. Ptr gDisciplinedJmpToTrapPatchPoint;        // Location to patch in the MacApp dispatcher to the
  170.                                             // disciplined dispatching.
  171. //--------------------------------------------------------------------------------------------------
  172. // Procedures defined in UPascalObject.a for implementing optimized method dispatching.
  173.  
  174. extern pascal void InitLinkerSymbols(void);
  175.  
  176. //--------------------------------------------------------------------------------------------------
  177. // Some forward declarations.
  178.  
  179. void InstallDispatcher(void);
  180. void OrderClassIdsByName(void);
  181. pascal void __ObjError(void);
  182.  
  183. //--------------------------------------------------------------------------------------------------
  184. // An iterator for iterator over class ids.
  185.  
  186. class CClassIterator: public CIterator
  187. {
  188. private:
  189.     ObjClassID    fCurrentID;
  190.     ObjClassID    fMaxID;
  191.     
  192. public:
  193.     CClassIterator(void);
  194.     
  195.     virtual Boolean More(void);                    // override
  196.     // Returns TRUE if there are more elements to iterate over
  197.  
  198.     virtual void Reset(void);                    // override
  199.     // Resets the iterator to begin again
  200.     
  201.     inline ObjClassID FirstClass(void);
  202.     // returns the first window in the window list
  203.  
  204.     inline ObjClassID NextClass(void);
  205.     // increments and then returns the current classID
  206.     
  207. protected:
  208.     virtual void Advance(void);                    // override
  209.     // Advances the iteration
  210. };
  211.  
  212. //--------------------------------------------------------------------------------------------------
  213.  
  214. inline CClassIterator::CClassIterator()
  215. {
  216.     fMaxID = pSuperClassTable->itsSize;
  217.     fCurrentID = sizeof(ObjClassID);
  218. }
  219.  
  220. //--------------------------------------------------------------------------------------------------
  221.  
  222. inline ObjClassID CClassIterator::FirstClass()
  223. {
  224.     return sizeof(ObjClassID);
  225. }
  226.  
  227. //--------------------------------------------------------------------------------------------------
  228.  
  229. inline ObjClassID CClassIterator::NextClass()
  230. {
  231.     this->Advance();
  232.     return fCurrentID;
  233. }
  234.  
  235. //--------------------------------------------------------------------------------------------------
  236. #pragma segment MAObjectRes
  237.  
  238. Boolean CClassIterator::More()
  239. {
  240.     return (fCurrentID < fMaxID);
  241. }
  242.  
  243. //--------------------------------------------------------------------------------------------------
  244. #pragma segment MAObjectRes
  245.  
  246. void CClassIterator::Reset()
  247. {
  248.     fCurrentID = this->FirstClass();
  249. }
  250.  
  251. //--------------------------------------------------------------------------------------------------
  252. #pragma segment MAObjectRes
  253.  
  254. void CClassIterator::Advance()
  255. {
  256.     fCurrentID += sizeof(ObjClassID);
  257. }
  258.  
  259. //--------------------------------------------------------------------------------------------------
  260. #pragma segment MAObjectRes
  261.  
  262. pascal CompareResult TestKey(long theClassID, MAName* keyStr)
  263. {
  264.     MAName        itemName;
  265.  
  266.     GetClassNameFromID((ObjClassID) theClassID, itemName);
  267.     return RelString(*keyStr, itemName, FALSE, TRUE);
  268. }
  269.  
  270. pascal ObjClassID TNameOrderedClassIDs::ClassIDWithName(MAName keyStr)
  271. {
  272.     return (ObjClassID) Search((CompareLongType) TestKey, &keyStr);
  273. }
  274.  
  275. //--------------------------------------------------------------------------------------------------
  276.  
  277. // Overridden to string compare the actual names of the classes
  278.  
  279. pascal CompareResult TNameOrderedClassIDs::Compare(long item1, long item2) // override 
  280. {
  281.     MAName item1Name, item2Name;
  282.  
  283.     GetClassNameFromID((ObjClassID) item1, item1Name);
  284.     GetClassNameFromID((ObjClassID) item2, item2Name);
  285.     return RelString(item1Name, item2Name, FALSE, TRUE);
  286. }
  287.  
  288. //--------------------------------------------------------------------------------------------------
  289. #pragma segment MAObjectRes
  290.  
  291. pascal Boolean AllocateObjectsFromPerm(Boolean allocateFromPerm)
  292. {
  293.     Boolean previousState = pAllocateObjectsFromPerm;
  294.     pAllocateObjectsFromPerm = allocateFromPerm;
  295.     return previousState;
  296. }
  297.  
  298. //--------------------------------------------------------------------------------------------------
  299. #pragma segment MAObjectRes
  300.  
  301. pascal Boolean DisciplineMethodCalls(Boolean discipline)
  302. {
  303.     Boolean previousState = pDisciplineMethodCalls;
  304.     pDisciplineMethodCalls = discipline;
  305.     return previousState;
  306. }
  307.  
  308. //--------------------------------------------------------------------------------------------------
  309. #pragma segment MAObjectRes
  310.  
  311. pascal void EachClassDo(DoToClassType DoToClass, void* staticLink)
  312. {
  313.     // Manufacture classIDs for all classes from the root to the largest 
  314.     
  315.     /* NOTE: Since maxID is obtained from the size of the super class table, maxID serves as a
  316.     maximum bound on the possible range of class IDs. So, in the loop below, we only call DoToClass
  317.     while aClassID is less than maxID. This is because the size (in bytes) of the
  318.     super class table includes the bytes required to enter the size at the head of the
  319.     super class table.
  320.  
  321.     Incidentally, since the class table follows the super class table, this gives us the
  322.     following identity:
  323.         superclass table ptr + size of super class table == class table ptr
  324.  
  325.     So, in 16-bit worlds, for a two class system, the superclass table could look like:
  326.         0x0006 0x0000 0x0002    <= super class table with class IDs 2 and 4, followed by
  327.         0x0006 0x4ADA 0x4ADC    <= class table with offsets into jump table
  328.     this structure gives us a maxID of 6 and the following while loop looks like:
  329.  
  330.         while ( aClassID < 6)…
  331.             aClassID = aClassID + 2
  332.     */
  333.     
  334.     CClassIterator iter;
  335.  
  336.     for (ObjClassID aClassID = iter.FirstClass(); iter.More(); aClassID = iter.NextClass())
  337.         DoToClass(aClassID, staticLink);
  338. }
  339.  
  340. //--------------------------------------------------------------------------------------------------
  341. #pragma segment MAObjectRes
  342.  
  343. pascal void EachSubClassDo(ObjClassID testClass, DoToClassType DoToClass, void* staticLink)
  344. {
  345.     CClassIterator iter;
  346.  
  347.     for (ObjClassID theClass = iter.FirstClass(); iter.More(); theClass = iter.NextClass())
  348.         if (theClass != testClass && IsClassIDMemberClass(theClass, testClass))
  349.             DoToClass(theClass, staticLink);
  350. }
  351.  
  352.  
  353. //--------------------------------------------------------------------------------------------------
  354. #pragma segment MAObjectRes
  355.  
  356. pascal void EachSuperClassDo(ObjClassID testClass, DoToClassType DoToClass, void* staticLink)
  357. {
  358.     ObjClassID    theSuperClass = GetSuperClassID(testClass);
  359.     while (theSuperClass != kNilClass)
  360.     {
  361.         DoToClass(theSuperClass, staticLink);
  362.         theSuperClass = GetSuperClassID(theSuperClass);
  363.     }
  364. }
  365.  
  366.  
  367. //--------------------------------------------------------------------------------------------------
  368. #pragma segment MAObjectRes
  369.  
  370. pascal void FailNonObject(TObject* obj)
  371. {
  372.     if (!IsObject(obj))
  373.     {
  374. #if qDebugMsg
  375.         VerboseIsObject(obj);                            // show why
  376.         fprintf(stderr, "Object that failed discipline %p\n", obj);
  377.         ProgramBreak("");
  378. #endif
  379.         Failure(minErr, 0);                             // ??? need to assign a message 
  380.     }
  381. }
  382.  
  383.  
  384. //--------------------------------------------------------------------------------------------------
  385. #pragma segment MAObjectRes
  386.  
  387. pascal TObject *FreeIfObject(TObject* obj)
  388. {
  389.     if (obj)
  390.     {
  391. #if qDebug
  392.         if (!VerboseIsObject(obj))
  393.             ProgramBreak("In FreeIfObject: Not handed a valid object.");
  394. #endif
  395.         obj->Free();
  396.     }
  397.     return NULL;
  398. }
  399.  
  400.  
  401. //--------------------------------------------------------------------------------------------------
  402. #pragma segment MAObjectRes
  403.  
  404. pascal ObjClassID GetClassID(TObject* obj)
  405. {
  406. #if qDebug
  407.     FailNonObject(obj);
  408. #endif
  409.     return **((ObjClassIDHandle) obj);
  410. }
  411.  
  412. //--------------------------------------------------------------------------------------------------
  413. #pragma segment MAObjectRes
  414.  
  415. pascal ObjClassID GetClassIDFromName(const MAName& clName)
  416. {
  417.     ObjClassID    classID = pOrderedClassIds->ClassIDWithName(clName);
  418.  
  419. #if qDebugMsg
  420.     if (classID == kNilClass)
  421.     {
  422.         fprintf(stderr, "###GetClassIDFromName: Can't find class name %s\n", (char *) clName);
  423.         if (gIntenseDebugging)
  424.             ProgramBreak("");
  425.     }
  426. #endif
  427.  
  428.     return classID;
  429. }
  430.  
  431.  
  432. //--------------------------------------------------------------------------------------------------
  433. #pragma segment MAObjectRes
  434.  
  435. ClassInfoProcHandle GetClassInfoProcHandle(ObjClassID classID)
  436. {
  437.     // The following piece of code depends on Ptr being a (char *) and Handle being a (char **).
  438.     // Remember C++ pointer arithmetic accounts for the size of the object pointed to!
  439.         
  440.     ClassInfoProcHandle    aClassInfoProcHandle = (ClassInfoProcHandle) 
  441.         ((qModelFarCode ? 0 : GetA5())
  442.             + *((ClassTableEntryPtr) ((Ptr) pClassTable + classID))
  443.             + kJTSkipOver);
  444.         
  445.     return aClassInfoProcHandle;
  446. }
  447.  
  448. //--------------------------------------------------------------------------------------------------
  449. #pragma segment MAObjectRes
  450.  
  451. pascal void GetClassNameFromID(ObjClassID classID, MAName& clName)
  452. {
  453.     const Str255 kClasInfoPrefix = "CLASINFO.";        // 'CLASINFO.' prepended to class name 
  454.     ClassInfoProcHandle    aClassInfoProcHandle;
  455.     Ptr                    namePtr;
  456.     short                nameLength;
  457.     Ptr                    clNamePtr;
  458.     short                i;
  459.  
  460.     if (classID == kNilClass || odd(classID))
  461.         clName = kInvalidObj;
  462.     else
  463.     {
  464.         aClassInfoProcHandle = GetClassInfoProcHandle(classID);
  465.         namePtr = (Ptr) &(*aClassInfoProcHandle)->itsName;
  466.  
  467.         // discard = validMacsBugSymbol(namePtr, ord(namePtr) + 256, &clName); 
  468.         // delete(clName, 1, 9);                            // 'CLASINFO.' 
  469.         // !!! the above function call could conceivably return a null terminated pascal string
  470.         // that would exceed a Str255 by one byte.  If that happens we're HOSED.  The workaround
  471.         // is to have the validMacsBugSymbol call put the returned string on the stack with room
  472.         // for that last null byte.  The cost is yet another copy of the string on the stack. So…
  473.         // anticipating that no identifier names will ever ACTUALLY be 255 chars we take the simple
  474.         // path and return the name directly into the var parameter.
  475.  
  476.         // We need all the speed we can get here, so forego the use of validMacsBugSymbol
  477.         // (it did make a difference) and do it ourselves.  This routine would be a good
  478.         // candidate for assembly
  479.  
  480.         if (*((unsigned char *) namePtr) == 0x80)
  481.         {
  482.             namePtr++;
  483.             nameLength = *namePtr - kClasInfoPrefix.Length ();
  484.         }
  485.         else
  486.             nameLength = (((*namePtr)) & 0x7F) - kClasInfoPrefix.Length();
  487.         clName.Length() = (unsigned char) Min (kMANameSize, nameLength);
  488.         clNamePtr = (Ptr) &clName[1];
  489.         namePtr += kClasInfoPrefix.Length() + 1;
  490.  
  491.         // Be polite. Don't copy more bytes than the caller has reserved room for.
  492.         
  493.         int copyLen = (int) Min (clName.Length (), sizeof(MAName) - 1);
  494.         for (i=1; i<=copyLen; i++)
  495.             *clNamePtr++ = *namePtr++;
  496.     }
  497. }
  498.  
  499. //--------------------------------------------------------------------------------------------------
  500. #pragma segment MAObjectRes
  501.  
  502. pascal Size GetClassSizeFromID(ObjClassID classID)
  503. {
  504.     return (*GetClassInfoProcHandle(classID))->itsInstanceSize;
  505. }
  506.  
  507. //--------------------------------------------------------------------------------------------------
  508. #pragma segment MAObjectRes
  509.  
  510. pascal ObjClassID GetSuperClassID(ObjClassID objID)
  511. {
  512.     if (objID != kNilClass)
  513.         return *((ObjClassIDPtr) ((Ptr) pSuperClassTable + objID));
  514.     else
  515.         return kNilClass;
  516. }
  517.  
  518. //--------------------------------------------------------------------------------------------------
  519. #pragma segment MAObjectRes
  520.  
  521. SuperClassTablePtr GetSuperClassTablePtr(void)
  522. {
  523.     if (qModelFarCode)
  524.         return (SuperClassTablePtr) gSuperClassTable;
  525.     else
  526.         return (SuperClassTablePtr) gClassInfo;
  527. }
  528.     
  529. //--------------------------------------------------------------------------------------------------
  530. #pragma segment MAObjectRes
  531.  
  532. ClassTablePtr GetClassTablePtr(void)
  533. {
  534.     if (qModelFarCode)
  535.         return (ClassTablePtr) gClassTable;
  536.     else
  537.         // Old style. Table is past end of superclass table 
  538.         return (ClassTablePtr) ((Ptr) GetSuperClassTablePtr() + GetSuperClassTablePtr()->itsSize);
  539. }
  540.     
  541. //--------------------------------------------------------------------------------------------------
  542. #pragma segment MAObjectRes
  543.  
  544. Ptr GetSelectorProcTablePtr(void)
  545. {
  546.     if (qModelFarCode)
  547.         return gSelectorProcTable;
  548.     else
  549.         return NULL;
  550. }
  551.  
  552. //--------------------------------------------------------------------------------------------------
  553. #pragma segment MAInit
  554.  
  555. pascal void InitUObject(void)
  556. {
  557.     InitLinkerSymbols();
  558.     
  559.     if (qDebug)
  560.         pDisciplineMethodCalls = FALSE;
  561.  
  562.     if (qInspector)
  563.         AddNewObjectsToInspector(FALSE);
  564.  
  565.     pDisciplineCoercions = FALSE;                        // so run time coercions are not checked 
  566.  
  567.     pAllocateObjectsFromPerm = TRUE;
  568.  
  569.     InstallDispatcher();
  570.  
  571.     SetStdObjProcs(gObjProcs);
  572.  
  573.     pTObjectClassID = (ObjClassID) sizeof(ObjClassID);
  574.  
  575. #ifdef Comment
  576.     {
  577.         ofstream out ("ClassInfo.unordered");
  578.         CClassIterator iter;
  579.     
  580.         for (ObjClassID theClass = iter.FirstClass(); iter.More(); theClass = iter.NextClass())
  581.         {
  582.             ClassInfoProc& aClassInfoProc = **GetClassInfoProcHandle(theClass);
  583.             
  584.             out << "Class Name: " << aClassInfoProc.itsName << "\n";
  585.             out << "      ID:   " << aClassInfoProc.itsClassID << "\n";
  586.             out << "      Size: " << aClassInfoProc.itsInstanceSize << "\n";
  587.             out << "\n";
  588.         }
  589.         out.close();
  590.     }
  591. #endif
  592.  
  593.     OrderClassIdsByName();
  594.     
  595.     if (qRangeCheck)
  596.         pDisciplineCoercions = TRUE;
  597.  
  598.     if (qInspector)
  599.         AddNewObjectsToInspector(TRUE);
  600.  
  601.     if (qDebug)
  602.         pDisciplineMethodCalls = TRUE;
  603. }
  604.  
  605. //--------------------------------------------------------------------------------------------------
  606. #pragma segment MAObjectRes
  607.  
  608. pascal Boolean IsObject(TObject *obj)
  609. {
  610.     return gObjProcs.IsObjectProc(obj);
  611. }
  612.  
  613. //--------------------------------------------------------------------------------------------------
  614. #pragma segment MAObjectRes
  615.  
  616. pascal Boolean ObjIsObjectProc(TObject *obj)
  617. {
  618.     // Test for handle not purged since we don't allow purgeable objects (??? yet?, ever?) 
  619.     // Test objecthood 
  620.     
  621.     if (IsHandle((Handle) obj) &&
  622.             (*Handle(obj)) &&
  623.             IsClassIDMemberClass(**((ObjClassIDHandle) obj), pTObjectClassID) &&
  624.             GetHandleSize(Handle(obj)) >= GetClassSizeFromID(**((ObjClassIDHandle) obj)))
  625.         return TRUE;
  626.     else
  627.         return FALSE;
  628. }
  629.     
  630. //--------------------------------------------------------------------------------------------------
  631. #pragma segment MAObjectRes
  632.  
  633. pascal Boolean IsMemberClassID(TObject *obj, ObjClassID objID)
  634. {
  635. #if qDebug
  636.     FailNonObject(obj);
  637.  
  638.     if (!IsObject(obj))
  639.         return FALSE;
  640. #endif
  641.  
  642.     return IsClassIDMemberClass(**((ObjClassIDHandle) obj), objID);
  643. }
  644.     
  645. //--------------------------------------------------------------------------------------------------
  646. #pragma segment MAObjectRes
  647.  
  648. // makes objects for "new" calls.  Internal use only. 
  649. pascal TObject *MakeNewInstance(ObjClassID classID)
  650. {
  651.     TObject* returnObj = gObjProcs.AllocateProc(classID);
  652.     
  653.     FailNIL(returnObj);
  654.     return returnObj;
  655. }
  656.  
  657. //--------------------------------------------------------------------------------------------------
  658. #pragma segment MAObjectRes
  659.  
  660. // makes objects for "new" calls.  Internal use only. 
  661.  
  662. pascal TObject *ObjAllocateProc(ObjClassID classID)
  663. {
  664.     const unsigned char initVal = 0xF1;        // guaranteed to be odd at all byte boundaries
  665.     TObject        *obj;
  666.  
  667.     if (classID != kNilClass)
  668.     {
  669.         Size itsSize = GetClassSizeFromID(classID);
  670.         if ((pCacheObj) && !IsHandlePurged(Handle(pCacheObj)) &&
  671.            GetHandleSize(Handle(pCacheObj)) >= itsSize)
  672.         {
  673.             obj = pCacheObj;
  674.             SetHandleSize(Handle(pCacheObj), itsSize);
  675.             HNoPurge(Handle(pCacheObj));
  676.             pCacheObj = NULL;
  677.         }
  678.         else
  679.         {
  680.             if (qMacApp && pAllocateObjectsFromPerm)
  681.                 obj = (TObject *) NewPermHandle(itsSize);
  682.             else
  683.                 obj = (TObject *) NewHandle(itsSize);
  684.         }
  685.  
  686.         if (obj)
  687.         {
  688.             if (qDebug)
  689.                 BlockSet(*((Handle) obj), itsSize, initVal);
  690.  
  691.             // Install class ID into object 
  692.             **((ObjClassIDHandle) obj) = classID;
  693.         }
  694.     }
  695.     else
  696.         obj = NULL;
  697.  
  698.     if (qInspector)
  699.         AddObjectToInspector(obj);
  700.     
  701.     return obj;
  702. }
  703.  
  704. //--------------------------------------------------------------------------------------------------
  705. #pragma segment MAObjectRes
  706.  
  707. pascal TObject *NewObjectByClassId(ObjClassID classID)
  708. {
  709. #if qDebugMsg
  710.     if (gAskAboutAlloc && CanReadLn())
  711.     {
  712.         MAName        caller;
  713.         MAName        className;
  714.         
  715.         GetCallersMethodName(caller);
  716.         GetClassNameFromID(classID, className);
  717.         fprintf(stderr, "Within %s, trying to make a '%s'.\n", (char *) caller, (char *) className);
  718.  
  719.         if (ReadYesNo("     Return NULL (Y or N) [N]? "))
  720.             return NULL;
  721.     }
  722. #endif
  723.  
  724.     return MakeNewInstance(classID);
  725. }
  726.  
  727. //--------------------------------------------------------------------------------------------------
  728. #pragma segment MAObjectRes
  729.  
  730. pascal TObject *NewObjectByClassName(const MAName& className)
  731. {
  732. #if qDebugMsg
  733.     if (gAskAboutAlloc && CanReadLn())
  734.     {
  735.         MAName    s;
  736.         
  737.         GetCallersMethodName(s);
  738.         fprintf(stderr, "Within %s, trying to make a '%s'.\n", (char *) s, (char *) className);
  739.  
  740.         if (ReadYesNo("     Return NULL (Y or N) [N]? "))
  741.             return NULL;
  742.     }
  743. #endif
  744.  
  745.     ObjClassID    classID = GetClassIDFromName(className);
  746.     if (classID != kNilClass)
  747.         return MakeNewInstance(classID);
  748.     else
  749.         return NULL;
  750. }
  751.  
  752. //--------------------------------------------------------------------------------------------------
  753. #pragma segment MAObjectRes
  754.  
  755. #if qDebugMsg
  756. pascal void OBJFail(short error)
  757. #else
  758. pascal void OBJFail(short)
  759. #endif
  760. {
  761. #if qDebugMsg
  762.     switch (error)
  763.     {
  764.         case kFailCoercion:
  765.             ProgramBreak("Object type coercion error.");
  766.             break;
  767.         case kFailMethNotFound:
  768.             ProgramBreak("Method not found");
  769.             break;
  770.         default:
  771.             fprintf(stderr, "Failure code: %d\n", error);
  772.             ProgramBreak("Object runtime failure. See UObject.p.");
  773.             break;
  774.     }
  775. #endif
  776. #if qMacApp
  777.     Failure(minErr, 0);                                 // ??? need to assign a message 
  778. #else
  779.     // ??? Should we do anything if not for MacApp? 
  780. #endif
  781. }
  782.  
  783. //--------------------------------------------------------------------------------------------------
  784. #pragma segment MAObjectRes
  785.  
  786. void OrderClassIdsByName(void)
  787. {
  788.     CClassIterator iter;
  789.     pOrderedClassIds = new TNameOrderedClassIDs;
  790.     pOrderedClassIds->ISortedLongintList();
  791.  
  792.     for (ObjClassID theClass = iter.FirstClass(); iter.More(); theClass = iter.NextClass())
  793.         if (pClassTable->itsTable[theClass / sizeof(ObjClassID)] != 0)
  794.             pOrderedClassIds->Insert((long) theClass);
  795. }
  796.  
  797. //--------------------------------------------------------------------------------------------------
  798. #pragma segment MADebug
  799.  
  800. pascal Boolean VerboseIsObject(TObject *obj)
  801.  
  802. {
  803.         MAName        className;
  804.         Size        classSize;
  805.         Size        instSize;
  806.  
  807.     
  808.     // Test for handle not purged since we don't allow purgeable objects (??? yet?, ever?) 
  809.  
  810.     if (VerboseIsHandle((Handle) obj))
  811.     {
  812.         if (*((Handle) obj) == NULL)
  813.             fprintf(stderr, " That handle appears to be purged.\n");
  814.         else if (!IsClassIDMemberClass(**((ObjClassIDHandle) obj), pTObjectClassID))
  815.             fprintf(stderr, "  That handle is not a subclass of TObject.\n");
  816.         else if (GetHandleSize((Handle) obj) < GetClassSizeFromID(GetClassID(obj)))
  817.         {
  818.             GetClassNameFromID(GetClassID(obj), className);
  819.             classSize = GetClassSizeFromID(GetClassID(obj));
  820.             instSize = GetHandleSize((Handle) obj);
  821.             fprintf(stderr, "  That handle at: %ld bytes is smaller than a %s is supposed to be at: %ld bytes.\n",
  822.                     instSize, (char *) className, classSize);
  823.         }
  824.         else
  825.             return TRUE;
  826.     }
  827.     
  828.     return TRUE;
  829. }
  830.  
  831. //--------------------------------------------------------------------------------------------------
  832. #pragma segment %MAInit
  833.  
  834. // LOW LEVEL one time initialization. Must be in same segment as dispatcher. 
  835.  
  836. void InstallDispatcher(void)
  837. {
  838.     struct JmpToTrapPatch {
  839.         short            Jmp;            // jmp instruction
  840.         PascalProc        Routine;        // address to jump to
  841.     };
  842.     typedef JmpToTrapPatch *JmpToTrapPatchPtr;
  843.     
  844.     JmpToTrapPatchPtr        aJmpToTrapPatchPtr;
  845.  
  846.     
  847.     /* The new method dispatcher provided with MacApp is enough faster that it is even worth using
  848.     instead of the ROM based dispatcher. */
  849.  
  850. #if qDebug
  851.     pODFail = &FailNonObject;
  852. #endif
  853.  
  854. /* NOTE =================================================
  855.  the following is a real slimedog trick but since we are
  856.  after performance in this bottleneck we'll do it anyway.
  857.  since it saves a memory fetch for each dispatch.
  858.  Don't need to flush the cache here.
  859.  */
  860.     aJmpToTrapPatchPtr = (JmpToTrapPatch *) gJmpToTrapPatchPoint;
  861.     aJmpToTrapPatchPtr->Jmp = 0x4EF9;
  862. #if qDebug
  863.     aJmpToTrapPatchPtr->Routine = (PascalProc) gDisciplinedMethDispAddr;
  864. #else
  865.     aJmpToTrapPatchPtr->Routine = (PascalProc) gMethDispAddr;
  866. #endif
  867.     
  868. #if qDebug
  869.     aJmpToTrapPatchPtr = (JmpToTrapPatchPtr) gDisciplinedJmpToTrapPatchPoint;
  870.     aJmpToTrapPatchPtr->Jmp = 0x4EF9;                                    // JMP #Routine 
  871.     aJmpToTrapPatchPtr->Routine = (PascalProc) gMethDispAddr;
  872. #endif
  873.  
  874.     // Don't forget the class and superclass tables and the error handler 
  875.     
  876.     pSuperClassTable = GetSuperClassTablePtr();
  877.     pClassTable = GetClassTablePtr();
  878. //    if (GetSelectorProcTablePtr());             /*!!! suppress dead strip of table. Fix b4 final */
  879.     pDispatchErrorProc = &__ObjError;
  880. }
  881.  
  882. //--------------------------------------------------------------------------------------------------
  883. #pragma segment MAObjectRes
  884.  
  885. /* LOW LEVEL routine called at run time verify object coercions.  It returns its obj
  886. parameter if the parameter is nil or passes the membership test.  Otherwise it calls
  887. ObjFail.  */
  888.  
  889. pascal TObject *__OBCHK(TObject *obj, Ptr jumpTablePtr)
  890. {
  891.     if (pDisciplineCoercions)
  892.     {
  893. #if qDebug
  894.         if (obj)
  895.             FailNonObject(obj);
  896. #endif
  897.         if ((obj) && !IsClassIDMemberClass(**((ObjClassIDHandle) obj),
  898.                                                     **((ObjClassIDHandle) jumpTablePtr)))
  899.             OBJFail(kFailCoercion);
  900.     }
  901.     
  902.     return obj;
  903. }
  904.  
  905.  
  906. //--------------------------------------------------------------------------------------------------
  907. #pragma segment MAObjectRes
  908.  
  909. /* LOW LEVEL routine called by DISPOSE(<object>).
  910. Forwards to the dispose bottleneck. */
  911.  
  912. pascal void __OBDISP(TObject *obj)
  913. {
  914.     gObjProcs.DisposeProc(obj);
  915. }
  916.     
  917. //--------------------------------------------------------------------------------------------------
  918. #pragma segment MAObjectRes
  919.  
  920. // Default LOW LEVEL proc used in Dispose object bottleneck
  921.  
  922. pascal void ObjDisposeProc(TObject *obj)
  923. {
  924. #if qDebug
  925.     FailNonObject(obj);
  926. #endif
  927.  
  928.     if (qInspector)
  929.         RemoveObjectFromInspector(obj);
  930.  
  931.     if ((pCacheObj) &&
  932.         !IsHandlePurged((Handle) pCacheObj) &&
  933.         GetHandleSize((Handle) pCacheObj) >= GetHandleSize((Handle) obj))
  934.     { // cached one is better 
  935.         obj = (TObject *) DisposeIfHandle((Handle) obj);
  936.     }
  937.     else
  938.     { // new one is better 
  939.         if (pCacheObj)
  940.             pCacheObj = (TObject *) DisposeIfHandle((Handle) pCacheObj);
  941.  
  942.         pCacheObj = obj;
  943.         HPurge((Handle) pCacheObj);
  944.     }
  945. }
  946.  
  947. //--------------------------------------------------------------------------------------------------
  948. #pragma segment MAObjectRes
  949.  
  950. pascal void SetStdObjProcs(ObjProcs& theObjProcs)
  951. {
  952.     theObjProcs.AllocateProc = ObjAllocateProc;
  953.     theObjProcs.DisposeProc = ObjDisposeProc;
  954.     theObjProcs.IsObjectProc = ObjIsObjectProc;
  955. }
  956.  
  957. //--------------------------------------------------------------------------------------------------
  958. #pragma segment MAObjectRes
  959.  
  960. /* LOW LEVEL Error routine that ROM method dispatch routine jumps to if method not found
  961.   Address of this routine is stuffed at lomem location MAErrProc at startup */
  962.  
  963. pascal void __ObjError(void)
  964. {
  965.     OBJFail(kFailMethNotFound);                         // Method Not Found 
  966. }
  967.  
  968. //--------------------------------------------------------------------------------------------------
  969. #pragma segment MAObjectRes
  970.  
  971. // LOW LEVEL routine called by NEW(<object>); 
  972.  
  973. pascal void __OBNEW(TObject*& obj, Ptr jumpTablePtr, short)
  974. {
  975.     ObjClassID        classID = (*((ClassInfoProcHandle) jumpTablePtr))->itsClassID;
  976.  
  977. #if qDebugMsg
  978.     if (gAskAboutAlloc && CanReadLn())
  979.     {
  980.         MAName        caller;
  981.         MAName        className;
  982.     
  983.         GetCallersMethodName(caller);
  984.         GetClassNameFromID(classID, className);
  985.         fprintf(stderr, "Within %s, trying to make a '%s'.\n", (char *) caller, (char *) className);
  986.         if (ReadYesNo("     Return NULL (Y or N) [N]? "))
  987.         {
  988.             obj = NULL;
  989.             return;
  990.         }
  991.     }
  992. #endif
  993.  
  994.     obj = NULL;                                         // in case failure is signalled 
  995.     obj = MakeNewInstance(classID);
  996. }
  997.  
  998. //--------------------------------------------------------------------------------------------------
  999. #pragma segment MAObjectRes
  1000.  
  1001. // LOW LEVEL called to perform MEMBER function 
  1002.  
  1003. pascal Boolean __OPTINOBJ(TObject *obj, Ptr jumpTablePtr)
  1004. {
  1005. #if qDebug
  1006.     if (obj)
  1007.         FailNonObject(obj);
  1008. #endif
  1009.     return (obj) && IsClassIDMemberClass(**((ObjClassIDHandle) obj),
  1010.                                                   (*((ClassInfoProcHandle) jumpTablePtr))->itsClassID);
  1011. }
  1012.  
  1013. //--------------------------------------------------------------------------------------------------
  1014.  
  1015. // Must actually be in "Main" since it is called in UNIT setup by Pascal */
  1016.  
  1017. #pragma segment Main
  1018.  
  1019. /* LOW LEVEL The Pascal compiler generates code to call this procedure automatically, before
  1020. initializing the units and starting the application"s main program.  This function must always
  1021. work on 64K ROMs. */
  1022.  
  1023. pascal void __PGM1(void)
  1024. {
  1025. }
  1026.